(defpackage :nondestructive
  (:use :cl)
  (:shadow :condition)
  (:nicknames :nd))

(in-package :nondestructive)

(defvar *condition* :basic)
(defvar *switch-op* :proposed)

(defclass nondestructive (v:vanilla pm:propagate-mixin ri:rollover-input-mixin rs:rollover-selection-mixin)
  ((condition :initarg :condition :accessor condition)
   (original-diagram :accessor original-diagram)
   (mistake-diagram :accessor mistake-diagram)
   (mistake-switch :accessor mistake-switch)
   (mistake-layout :accessor mistake-layout))
  (:default-initargs
   :last-state-mode :sticky-surgery
   :condition *condition*
;;    :keypad-class 'keypad:simple-keypad
    ))

(defun get-switch (trial &optional (which *switch-op*))
  (ecase which
    (:original (nd-switch-transformations (condition trial)))
    (:proposed (new-switch-1 (condition trial)))
    (:optimized (new-switch-2 (condition trial)))))

(defun cycle-switch ()
  (labels ((switch (trial)
             (setf *switch-op* (or (second (member *switch-op* '(:original :proposed :optimized)))
                                   :original)
                   (o:transformations (find :switch-additive-operations (p:operations trial) :key 'o:name))
                   (get-switch trial))))
    (let ((state (exp:current-state exp:*experiment*)))
      (switch state)
      (when (p:guidedp state) (p:show-hint state))
      (p:display-message state :note "Switch operation set to ~a" *switch-op*))))

(defmethod bt:make-operations ((trial nondestructive))
  (with-slots (condition) trial
    (list
     (make-instance 'o:operation
                    :name :combine-multiplicative-operations
                    :transformations (nd-basic-combine condition)
                    :hint (ecase condition
                            (:minimum "Click some boxes and an operator.")
                            (:basic "Click the boxes pointed to by the green arrows and select Combine Multiplicative Operations.")
                            (:full "The numbers in two multiplication boxes can be combined. Click the boxes pointed to by the green arrows and select Combine Multiplicative Operations.")))
     (make-instance 'o:operation
                    :name :switch-additive-operations
                    :transformations (get-switch trial)
                    :hint (ecase condition
                            (:minimum "Click some boxes and an operator.")
                            (:basic "Click the boxes pointed to by the green arrows and select Switch Additive Operations.")
                            (:full "The order of two additions or subtractions can be switched. Click the boxes pointed to by the green arrows and select Switch Additive Operations.")))
     (make-instance 'o:operation
                    :name :collect-like-inputs
                    :transformations (append
                                      (nd-x-combine-transformations condition)
                                      (nd-x-weird-combine-transformations condition))
                    :hint (ecase condition
                            (:minimum "Click some boxes and an operator.")
                            (:basic "Click the boxes pointed to by the green arrows and select Collect Like Inputs.")
                            (:full "The same value from the top reaches a lower box by two routes. Click the boxes pointed to by the green arrows and select Collect Like Inputs.")))
     (make-instance 'o:operation
                    :name :multiply-additive-input
                    :transformations (reorder-2 condition)
                    :hint (ecase condition
                            (:minimum "Click some boxes and an operator.")
                            (:basic "Click the boxes pointed to by the green arrows and select Multiply Additive Input.")
                            (:full "When + or - box feeds into a * box you can reorder these boxes by multiplying the values in the * box. Click the boxes pointed to by the green arrows and select Multiply Additive Input."))))))

(defmethod pm:propagate-down-operation ((state nondestructive))
  (make-instance 'o:operation
                 :name :evaluate
                 :transformations (nd-evaluate-transformations (condition state))))

(defmethod pm:propagate-up-operation ((state nondestructive))
  (make-instance 'o:operation
                 :name :invert
                 :transformations (nd-invert-transformations (condition state))))

(defmethod pm:propagate-error-message ((trial nondestructive) node)
  (p:display-message trial :error (ecase (condition trial)
                                    (:minimum "You cannot click this box.")
                                    (:basic "You cannot click this box.")
                                    (:full "You are not ready to calculate the value of that box."))))

(defmethod bt:make-operation-views ((state nondestructive))
  (loop for i in (p:operations state)
       for name in '(("Combine" "Multiplicative" "Operations")
                     ("Switch Additive" "Operations")
                     ("Collect Like Inputs")
                     ("Multiply Additive" "Input"))
     collect (make-instance 'gwee:button
                            :height 50
                            :width :maximum
                            :data name ;(string-capitalize (o:name i))
                            :click-callback (let ((op (o:name i))) (exp:dispatch-event-fn exp:*experiment* state exp:click-event :source op)))))

(defmethod exp:state-dump append (exp (state nondestructive))
  `(:condition ,(condition state)))

(defmethod p:show-hint :after ((state nondestructive))
  (when (eq (condition state) :minimum)
    (d:clear-arrows (d:root (p:diagram state)))))

(defun read-input-in-status (trial target)
  (with-slots (vanilla::status-col vanilla::status) trial
    (let ((i (kp:read-string nil
                             0 0
                             :target target
                             :class 'kp::keypad
                             :submit-callback (lambda (s)
                                                (bt:delete-input trial)
                                                (setf (d:highlighted target) nil)
                                                (setf (gwee:view-subviews vanilla::status-col) (append (gwee:view-subviews vanilla::status-col)
                                                                                                       (list vanilla::status)))
                                                (setf (gwee:view-needs-update-p vanilla::status-col) t)
                                                (p:fill-input-box trial target s)
                                                (bt:refresh-diagram trial (p:diagram trial))))))
      (gwee:replace-view vanilla::status i)
      (setf (gwee:view-needs-update-p vanilla::status-col) t)
      i)))

(exp:define-action toggle-selection ((state nondestructive)
                                     (e:click-node :var id)
                                     (bt:select-mode))
  (let ((node (d:find-id-or-die (d:root (p:diagram state)) id)))
    (when node
      (setf (d:selected node) (not (d:selected node)))
      (bt:refresh-diagram state (p:diagram state)))))

(defmethod exp:dump-screen (exp (state nondestructive))
  `((:diagram ,(d:root (p:diagram state)))
    (:last-state ,(d:root (slot-value state 'bt:last-state)))
    (:operations ,@(mapcar 'o:name (p:operations state)))))

(defun update-mistake-layout (obj)
  (labels ((update (slot tree)
             (setf (d:root slot) (tree:copy-node tree t))
             (d:clear-arrows (d:root slot))
             (d:clear-selected (d:root slot))
             (fill-with-hypothetical-value (d:root slot))
             (tv:refresh-tree slot :center)))
    (update (mistake-diagram obj) (d:root (p:diagram obj)))
    (update (original-diagram obj) (if (h:before obj)
                                       (h:item-data (car (last (h:before obj))))
                                       (h:item-data (h:current obj))))))

(defun switch-last-state (obj &optional (to (if (eq (gwee:switchable-layout-current-view (mistake-switch obj))
                                                    (slot-value obj 'vanilla::last-area))
                                                :mistake :last))
                          force)
  (when (or force
            (eq to
                (if (eq (gwee:switchable-layout-current-view (mistake-switch obj))
                        (slot-value obj 'vanilla::last-area))
                    :mistake :last)))
    (exp:lg 'switch-last-state :to to :force force)
    (setf (gwee:switchable-layout-current-view (mistake-switch obj))
          (ecase to
            (:last
             (slot-value obj 'vanilla::last-area))
            (:mistake
             (update-mistake-layout obj)
             (mistake-layout obj)))
          (gwee:view-needs-update-p (mistake-switch obj)) t)))

(defmethod gwee:post-initialize-component progn ((obj nondestructive))
  (gwee:with-layout
      (:views
       (text gwee:text-area :data "Click To Return To Last Diagram State" :width :maximum)
       (original tv:tree-view)
       (mistake tv:tree-view))
      (:layouts
       (switch gwee:switchable-layout
         ())
       (top gwee:column-layout
            (text layout)
            :border-color (gwee:gray 0)
            :margin 5)
       (layout gwee:row-layout
               (original mistake)))
      (:parent nil :delete-p nil)
    (gwee:replace-view (slot-value obj 'vanilla::last-area) switch)
    (setf (gwee:view-subviews switch)
          (list (slot-value obj 'vanilla::last-area)
                top)
          (mistake-diagram obj) mistake
          (original-diagram obj) original
          (mistake-switch obj) switch
          (mistake-layout obj) top)
    (when (eq (condition obj) :full)
      (gwee:add-hook (gwee:mouse-press-hook switch)
                     (lambda (v b x y)
                       (declare (ignore v b x y))
                       (switch-last-state obj :last))))))

(defun fill-with-hypothetical-value (tree &optional (value 1))
  (labels ((fix (q)
             (if (stringp q)
                 (handler-case
                     (parse-integer q)
                   (parse-error ()
                     nil))
                 q))
             (propagate (box)
             (cond
               ;; xbox
               ((eql (length (tree:children box)) 1)
                (when (d:leaf-box-p box)
                  (setf (d:quantity (tree:child box)) value
                        (d:foreground (tree:child box)) (gwee:color 255 0 0)))
                (dolist (i (tree:parents box))
                  (setf (d:quantity i) (d:quantity (tree:child box))
                        (d:foreground i) (gwee:color 255 0 0))))
               ;; regular box  
               ((eql (length (tree:children box)) 3)
                (unless (notevery 'd:quantity (tree:children box))
                  (dolist (i (tree:parents box))
                    (setf (d:quantity i) (funcall (fix (d:quantity (second (tree:children box))))
                                                  (fix (d:quantity (first (tree:children box))))
                                                  (fix (d:quantity (third (tree:children box)))))
                          (d:foreground i) (gwee:color 255 0 0)))))
               (t (error "i dunno how to handle ~d parents of ~a" (length (tree:parents box)) box)))
             (mapc #'propagate (mapcar 'tree:parent (tree:parents box)))))
  (let ((leaves (remove-duplicates (d:collect-on-tree 'd:leaf-box-p tree))))
    (mapc #'propagate leaves)
    tree)))

(defmethod p:show-hint-fill-input :after ((problem nondestructive) tree)
  (when (and (eq (condition problem) :full)
             (o:surgeryp (p:transformation problem))
             (not (d:find-if-on-tree (lambda (n)
                                       (and (typep n 'd:input-argument)
                                            (null (d:quantity n))))
                                     tree))
             (d:find-if-on-tree (lambda (n)
                                  (and (typep n 'd:input-argument)
                                       (d:valid-input-p n (d:quantity n))
                                       (not (string= (d:quantity n) (u:string2 (d:answer n))))))
                                tree))
    (switch-last-state problem :mistake t)))

(defmethod p:finish-fill-mode progn ((problem nondestructive))
  (switch-last-state problem :last))

(defun sandbox ()
  (let ((rs (make-random-state))
        sessions messages)
    (handler-bind
        ((sf:equation-read-error (lambda (c)
                                   (push (format nil "~a" c) messages)
                                   (continue c))))
      (setf sessions (sf:read-all-sessions 'nondestructive '(panel:control-panel))))
    (exp:run-experiment
     sessions
     :startup-message messages
     :options (list (lambda (value)
                      (case value
                        (:full (setf *condition* :minimum))
                        (:basic (setf *condition* :full))
                        (:minimum (setf *condition* :basic))
                        (t *condition*))))
     :option-formatter 'string-capitalize
     :width 1220
     :height 730
     :log `(:random-state ,rs))))

(defun sandbox-full ()
  (let ((rs (make-random-state)))
    (exp:run-experiment
     `((:propogate-down (panel:control-panel) ,(propogate-down) (exp:end))
       (:propogate-up (panel:control-panel) ,(propogate-up) (exp:end))
       (:collapse (panel:control-panel) ,(collapse) (exp:end))
       (:switch (panel:control-panel :extra (cycle-switch)) ,(switch) (exp:end))
       (:combine (panel:control-panel :extra (cycle-switch)) ,(combine) (exp:end))
       (:reorder (panel:control-panel :extra (cycle-switch)) ,(reorder) (exp:end))
       )
     :options (list (lambda (value)
                      (case value
                        (:full (setf *condition* :minimum))
                        (:basic (setf *condition* :full))
                        (:minimum (setf *condition* :basic))
                        (t *condition*))))
     :option-formatter 'string-capitalize
     :width 1220
     :height 730
     :log `(:random-state ,rs))))
